
  PROCEDURE BLOCK(FSYS: SETOFSYS; FSY: SYMBOL; FPROCP: CTP);
    VAR LSY: SYMBOL;

    PROCEDURE LABELDECLARATION;
      VAR LLP: LABELP; REDEF: BOOLEAN;
    BEGIN
      REPEAT
	IF SY = INTCONST THEN
	  WITH DISPLAY[TOP] DO
	    BEGIN LLP := FLABEL; REDEF := FALSE;
	      WHILE (LLP <> NIL) AND NOT REDEF DO
		IF LLP^.LABVAL <> VAL.IVAL THEN
		  LLP := LLP^.NEXTLAB
		ELSE BEGIN REDEF := TRUE; ERROR(166) END;
	      IF NOT REDEF THEN
		BEGIN NEW(LLP);
		  WITH LLP^ DO
		    BEGIN LABVAL := VAL.IVAL;
		      CODELBP := NIL; NEXTLAB := FLABEL
		    END;
		  FLABEL := LLP
		END;
	      INSYMBOL
	    END
	ELSE ERROR(15);
	IF NOT ( SY IN FSYS + [COMMA, SEMICOLON] ) THEN
	  BEGIN ERROR(6); SKIP(FSYS+[COMMA,SEMICOLON]) END;
	TEST := SY <> COMMA;
	IF NOT TEST THEN INSYMBOL
      UNTIL TEST;
      IF SY = SEMICOLON THEN INSYMBOL ELSE ERROR(14)
    END (* LABELDECLARATION *) ;
  
    PROCEDURE CONSTDECLARATION;
      VAR LCP: CTP; LSP: STP; LVALU: VALU;
    BEGIN
      IF SY <> IDENT THEN
	BEGIN ERROR(2); SKIP(FSYS + [IDENT]) END;
      WHILE SY = IDENT DO
	BEGIN NEW(LCP,KONST);
	  WITH LCP^ DO
	    BEGIN NAME := ID; IDTYPE := NIL;
	      NEXT := NIL; KLASS := KONST
	    END;
	  INSYMBOL;
	  IF (SY = RELOP) AND (OP = EQOP) THEN INSYMBOL ELSE ERROR(16);
	  CONSTANT(FSYS + [SEMICOLON],LSP,LVALU);
	  ENTERID(LCP);
	  LCP^.IDTYPE := LSP; LCP^.VALUES := LVALU;
	  IF SY = SEMICOLON THEN
	    BEGIN INSYMBOL;
	      IF NOT (SY IN FSYS + [IDENT]) THEN
		BEGIN ERROR(6); SKIP(FSYS + [IDENT]) END
	    END
	  ELSE ERROR(14)
	END
    END (*CONSTDECLARATION*) ;
  
    PROCEDURE TYPEDECLARATION;
      VAR LCP,LCP1,LCP2: CTP; LSP: STP; LSIZE: ADDRRANGE;
    BEGIN
      IF SY <> IDENT THEN
	BEGIN ERROR(2); SKIP(FSYS + [IDENT]) END;
      WHILE SY = IDENT DO
	BEGIN NEW(LCP,TYPES);
	  WITH LCP^ DO
	    BEGIN NAME := ID; IDTYPE := NIL; KLASS := TYPES END;
	  INSYMBOL;
	  IF (SY = RELOP) AND (OP = EQOP) THEN INSYMBOL ELSE ERROR(16);
	  TYP(FSYS + [SEMICOLON],LSP,LSIZE);
	  ENTERID(LCP);
	  LCP^.IDTYPE := LSP;
	  LCP1 := FWPTR;
	  WHILE LCP1 <> NIL DO
	    BEGIN
	      IF LCP1^.NAME = LCP^.NAME THEN
		BEGIN
		  LCP1^.IDTYPE^.ELTYPE := LCP^.IDTYPE;
		  IF LCP1 <> FWPTR THEN
		    LCP2^.NEXT := LCP1^.NEXT
		  ELSE FWPTR := LCP1^.NEXT;
		END;
	      LCP2 := LCP1; LCP1 := LCP1^.NEXT
	    END;
	  IF SY = SEMICOLON THEN
	    BEGIN INSYMBOL;
	      IF NOT (SY IN FSYS + [IDENT]) THEN
		BEGIN ERROR(6); SKIP(FSYS + [IDENT]) END
	    END
	  ELSE ERROR(14)
	END;
      IF FWPTR <> NIL THEN
	BEGIN ERROR(117); FWPTR := NIL END
    END (*TYPEDECLARATION*) ;
  
    PROCEDURE VARDECLARATION;
      VAR LCP,NXT,IDLIST: CTP; LSP: STP; LSIZE: ADDRRANGE;
    BEGIN NXT := NIL;
      REPEAT
	REPEAT
	  IF SY = IDENT THEN
	    BEGIN NEW(LCP,VARS);
	      WITH LCP^ DO
	       BEGIN NAME := ID; NEXT := NXT; KLASS := VARS;
		  IDTYPE := NIL; VKIND := ACTUAL; VLEV := LEVEL
		END;
	      ENTERID(LCP);
	      NXT := LCP;
	      INSYMBOL;
	    END
	  ELSE ERROR(2);
	  IF NOT (SY IN FSYS + [COMMA,COLON] + TYPEDELS) THEN
	    BEGIN ERROR(6); SKIP(FSYS+[COMMA,COLON,SEMICOLON]+TYPEDELS) END;
	  TEST := SY <> COMMA;
	  IF NOT TEST THEN INSYMBOL
	UNTIL TEST;
	IF SY = COLON THEN INSYMBOL ELSE ERROR(5);
	IDLIST := NXT;
	TYP(FSYS + [SEMICOLON] + TYPEDELS,LSP,LSIZE);
	WHILE NXT <> NIL DO
	  WITH  NXT^ DO
	    BEGIN IDTYPE := LSP; VADDR := LC;
	      LC := LC + LSIZE; NXT := NEXT;
	      IF NEXT = NIL THEN
		IF LSP <> NIL THEN
		  IF LSP^.FORM = FILES THEN
		      BEGIN (*PUT IDLIST INTO LOCAL FILE LIST*)
			NEXT := DISPLAY[TOP].FFILE;
			DISPLAY[TOP].FFILE := IDLIST
		      END
	    END;
	IF SY = SEMICOLON THEN
	  BEGIN INSYMBOL;
	    IF NOT (SY IN FSYS + [IDENT]) THEN
	      BEGIN ERROR(6); SKIP(FSYS + [IDENT]) END
	  END
	ELSE ERROR(14)
      UNTIL (SY <> IDENT) AND NOT (SY IN TYPEDELS);
    IF FWPTR <> NIL THEN
	BEGIN ERROR(117); FWPTR := NIL END
    END (*VARDECLARATION*) ;
  
    PROCEDURE PROCDECLARATION(FSY: SYMBOL);
      VAR OLDLEV: 0..MAXLEVEL; LSY: SYMBOL; LCP,LCP1: CTP; LSP: STP;
	  FORW: BOOLEAN; OLDTOP: DISPRANGE; OLDPROC: PROCRANGE;
	  LLC,LCM: ADDRRANGE;  MARKP: ^INTEGER;
  
      PROCEDURE PARAMETERLIST(FSY: SETOFSYS; VAR FPAR: CTP; FCP: CTP);
	VAR LCP,LCP1,LCP2,LCP3: CTP; LSP: STP; LKIND: IDKIND;
	  LLC,LEN : ADDRRANGE; COUNT : INTEGER;
      BEGIN LCP1 := NIL; LLC := LC;
	IF NOT (SY IN FSY + [LPARENT]) THEN
	  BEGIN ERROR(7); SKIP(FSYS + FSY + [LPARENT]) END;
	IF SY = LPARENT THEN
	  BEGIN IF FORW THEN ERROR(119);
	    INSYMBOL;
	    IF NOT (SY IN [IDENT,VARSY]) THEN
	      BEGIN ERROR(7); SKIP(FSYS + [IDENT,RPARENT]) END;
	    WHILE SY IN [IDENT,VARSY] DO
	      BEGIN
		IF SY = VARSY THEN
		  BEGIN LKIND := FORMAL; INSYMBOL END
		ELSE LKIND := ACTUAL;
		LCP2 := NIL;
		COUNT := 0;
		REPEAT
		  IF SY = IDENT THEN
		    BEGIN NEW(LCP,VARS);
		      WITH LCP^ DO
			BEGIN NAME := ID; IDTYPE := NIL;
			  VKIND := LKIND; NEXT := LCP2;
			  KLASS := VARS; VLEV := LEVEL
			END;
		      ENTERID(LCP);
		      LCP2 := LCP; COUNT := COUNT + 1;
		      INSYMBOL
		    END;
		  IF NOT (SY IN FSYS + [COMMA,COLON]) THEN
		    BEGIN ERROR(7);
		      SKIP(FSYS + [COMMA,SEMICOLON,RPARENT,COLON])
		    END;
		  TEST := SY <> COMMA;
		  IF NOT TEST THEN INSYMBOL
		UNTIL TEST;
		IF SY = COLON THEN
		  BEGIN INSYMBOL;
		    IF SY = IDENT THEN
		      BEGIN
			SEARCHID([TYPES],LCP);
			LSP := LCP^.IDTYPE;
			LCP3 := LCP2;
			LEN := PTRSIZE;
			IF LSP <> NIL THEN
			  IF LKIND = ACTUAL THEN
			    IF LSP^.FORM = FILES THEN ERROR(121)
			    ELSE
			      IF LSP^.FORM <= POWER THEN LEN := LSP^.SIZE;
			LC := LC + COUNT * LEN;
			WHILE LCP2 <> NIL DO
			  BEGIN LCP := LCP2;
			    WITH LCP2^ DO
			      BEGIN IDTYPE := LSP;
				LCP2 := NEXT
			      END
			  END;
			LCP^.NEXT := LCP1; LCP1 := LCP3;
			INSYMBOL
		      END
		    ELSE ERROR(2);
		    IF NOT (SY IN FSYS + [SEMICOLON,RPARENT]) THEN
		      BEGIN ERROR(7); SKIP(FSYS + [SEMICOLON,RPARENT]) END;
		  END
		ELSE ERROR(5);
		IF SY = SEMICOLON THEN
		  BEGIN INSYMBOL;
		    IF NOT (SY IN FSYS + [IDENT,VARSY]) THEN
		      BEGIN ERROR(7); SKIP(FSYS + [IDENT,RPARENT]) END
		  END
	      END (*WHILE*) ;
	    IF SY = RPARENT THEN
	      BEGIN INSYMBOL;
		IF NOT (SY IN FSY + FSYS) THEN
		  BEGIN ERROR(6); SKIP(FSY + FSYS) END
	      END
	    ELSE ERROR(4);
	    FCP^.LOCALLC := LC; LCP3 := NIL;
	    WHILE LCP1 <> NIL DO
	      WITH LCP1^ DO
		BEGIN LCP2 := NEXT; NEXT := LCP3;
		  IF (KLASS = VARS) AND (IDTYPE <> NIL) THEN
		    IF (IDTYPE^.FORM <= POWER) OR (VKIND = FORMAL) THEN
		      BEGIN VADDR := LLC;
			IF VKIND = FORMAL THEN LLC := LLC + PTRSIZE
			ELSE LLC := LLC + IDTYPE^.SIZE
		      END
		    ELSE
		      BEGIN VADDR := LC;
			LC := LC + IDTYPE^.SIZE;
			LLC := LLC + PTRSIZE
		      END;
		  LCP3 := LCP1; LCP1 := LCP2
		END;
	    FPAR := LCP3
	  END
	    ELSE FPAR := NIL
    END (*PARAMETERLIST*) ;
  
    BEGIN (*PROCDECLARATION*)
      LLC := LC; LC := LCAFTERMARKSTACK;
      IF FSY = FUNCSY THEN LC := LC + REALSIZE;
      LINEINFO := LC; DP := TRUE;
      IF SY = IDENT THEN
	BEGIN SEARCHSECTION(DISPLAY[TOP].FNAME,LCP);
	  IF LCP <> NIL THEN
	   BEGIN
	    IF LCP^.KLASS = PROC THEN
	      FORW := LCP^.FORWDECL AND (FSY = PROCSY)
		      AND (LCP^.PFKIND = ACTUAL)
	    ELSE
	      IF LCP^.KLASS = FUNC THEN
		FORW := LCP^.FORWDECL AND (FSY = FUNCSY)
			AND (LCP^.PFKIND = ACTUAL)
	      ELSE FORW := FALSE;
	    IF NOT FORW THEN ERROR(160)
	   END
	  ELSE FORW := FALSE;
	  IF NOT FORW THEN
	    BEGIN
	      IF FSY = PROCSY THEN NEW(LCP,PROC,DECLARED,ACTUAL)
	      ELSE NEW(LCP,FUNC,DECLARED,ACTUAL);
	      WITH LCP^ DO
		BEGIN NAME := ID; IDTYPE := NIL; LOCALLC := LC;
		  PFDECKIND := DECLARED; PFKIND := ACTUAL;
		  INSCOPE := FALSE; PFLEV := LEVEL;
		  PFNAME := NEXTPROC; PFSEG := SEG;
		  IF NEXTPROC = MAXPROCNUM THEN ERROR(251)
		  ELSE NEXTPROC := NEXTPROC + 1;
		  IF FSY = PROCSY THEN KLASS := PROC
		  ELSE KLASS := FUNC
		END;
	      ENTERID(LCP)
	    END
	  ELSE
	    BEGIN LCP1 := LCP^.NEXT;
	      WHILE LCP1 <> NIL DO
		BEGIN
		  WITH LCP1^ DO
		    IF KLASS = VARS THEN
		      IF IDTYPE <> NIL THEN
			BEGIN
			  IF VKIND = FORMAL THEN LCM := VADDR + PTRSIZE
			  ELSE LCM := VADDR + IDTYPE^.SIZE;
			  IF LCM > LC THEN LC := LCM
			END;
		  LCP1 := LCP1^.NEXT
		END
	      END;
	  INSYMBOL
	END
      ELSE
	BEGIN ERROR(2); LCP := UPRCPTR END;
      OLDLEV := LEVEL; OLDTOP := TOP; OLDPROC := CURPROC;
      CURPROC := LCP^.PFNAME;
      IF LEVEL < MAXLEVEL THEN LEVEL := LEVEL + 1 ELSE ERROR(251);
      IF TOP < DISPLIMIT THEN
	BEGIN TOP := TOP + 1;
	  WITH DISPLAY[TOP] DO
	    BEGIN
	      IF FORW THEN FNAME := LCP^.NEXT
	      ELSE FNAME := NIL;
	      FLABEL := NIL; FFILE := NIL; OCCUR := BLCK
	    END
	END
      ELSE ERROR(250);
      IF FSY = PROCSY THEN
	BEGIN PARAMETERLIST([SEMICOLON],LCP1,LCP);
	  IF NOT FORW THEN LCP^.NEXT := LCP1
	END
      ELSE
	BEGIN PARAMETERLIST([SEMICOLON,COLON],LCP1,LCP);
	  IF NOT FORW THEN LCP^.NEXT := LCP1;
	  IF SY = COLON THEN
	    BEGIN INSYMBOL;
	      IF SY = IDENT THEN
		BEGIN IF FORW THEN ERROR(122);
		  SEARCHID([TYPES],LCP1);
		  LSP := LCP1^.IDTYPE;
		  LCP^.IDTYPE := LSP;
		  IF LSP <> NIL THEN
		    IF NOT (LSP^.FORM IN [SCALAR,SUBRANGE,POINTER]) THEN
		      BEGIN ERROR(120); LCP^.IDTYPE := NIL END;
		  INSYMBOL
		END
	      ELSE BEGIN ERROR(2); SKIP(FSYS + [SEMICOLON]) END
	    END
	  ELSE
	    IF NOT FORW THEN ERROR(123)
	END;
      IF SY = SEMICOLON THEN INSYMBOL ELSE ERROR(14);
      IF SY = FORWARDSY THEN
	BEGIN
	  IF FORW THEN ERROR(161)
	  ELSE LCP^.FORWDECL := TRUE;
	  INSYMBOL;
	  IF SY = SEMICOLON THEN INSYMBOL ELSE ERROR(14);
	  IF NOT (SY IN FSYS) THEN
	    BEGIN ERROR(6); SKIP(FSYS) END
	END
      ELSE
	BEGIN MARK(MARKP);
	  WITH LCP^ DO
	    BEGIN FORWDECL := FALSE; INSCOPE := TRUE END;
	  REPEAT BLOCK(FSYS,SEMICOLON,LCP);
	    RELEASE(MARKP);
	    IF SY = SEMICOLON THEN
	      BEGIN INSYMBOL;
		IF NOT (SY IN [BEGINSY,PROCSY,FUNCSY,PROGSY]) THEN
		  BEGIN ERROR(6); SKIP(FSYS) END
	      END
	    ELSE ERROR(14)
    	  UNTIL SY IN [BEGINSY,PROCSY,FUNCSY,PROGSY];
	  LCP^.INSCOPE := FALSE
	END;
      LEVEL := OLDLEV; TOP := OLDTOP; LC := LLC; CURPROC := OLDPROC
    END (*PROCDECLARATION*) ;
  
    PROCEDURE SEGDECLARATION;
      VAR LSY: SYMBOL; OLDPROC: PROCRANGE; OLDSEG: SEGRANGE;
    BEGIN
      IF CODEINSEG THEN
	BEGIN ERROR(399); SEGINX := 0; CURBYTE := 0 END;
      OLDSEG := SEG; SEG := NEXTSEG; OLDPROC := NEXTPROC;
      IF NEXTSEG > MAXSEG THEN ERROR(250)
      ELSE NEXTSEG := NEXTSEG + 1;
      NEXTPROC := 1; LSY := SY;
      IF SY IN [PROCSY,FUNCSY] THEN INSYMBOL
      ELSE
	BEGIN ERROR(399); LSY := PROCSY END;
      IF SY = IDENT THEN SEGTABLE[SEG].SEGNAME := ID;
      PROCDECLARATION(LSY);
      IF CODEINSEG THEN FINISHSEG;
      NEXTPROC := OLDPROC; SEG := OLDSEG
    END (*SEGDECLARATION*) ;

    PROCEDURE BODY(FSYS: SETOFSYS);
      VAR LLC1,EXITIC: ADDRRANGE; LCP,LLCP: CTP; LOP: OPRANGE;
	  LLP: LABELP; LMIN,LMAX: INTEGER; JTINX: JTABRANGE;

    BEGIN NEXTJTAB := 1; WRITELN(OUTPUT);
      IF FPROCP = NIL THEN WRITELN(OUTPUT,'SYSTEM')
      ELSE
	BEGIN WRITELN(OUTPUT,FPROCP^.NAME);
	  LLC1 := FPROCP^.LOCALLC; LCP := FPROCP^.NEXT;
	  WHILE LCP <> NIL DO
	    WITH LCP^ DO
	      BEGIN
		IF KLASS = VARS THEN
		  IF IDTYPE <> NIL THEN
		    IF (VKIND = ACTUAL) AND (IDTYPE^.FORM > POWER) THEN
		      BEGIN LLC1 := LLC1 - PTRSIZE;
			GEN2(50(*LDA*),0,VADDR);
			GEN2(54(*LOD*),0,LLC1);
			IF PAOFCHAR(IDTYPE) THEN
			  WITH IDTYPE^ DO
			    IF AISSTRNG THEN GEN1(42(*SAS*),MAXLENG)
			    ELSE
			      IF INXTYPE <> NIL THEN
				BEGIN GETBOUNDS(INXTYPE,LMIN,LMAX);
				  GEN1(41(*MVB*),LMAX - LMIN + 1)
				END
			      ELSE
			ELSE GEN1(40(*MOV*),IDTYPE^.SIZE)
		      END
		    ELSE
		      IF VKIND = FORMAL THEN LLC1 := LLC1 - PTRSIZE
		      ELSE LLC1 := LLC1 - IDTYPE^.SIZE;
		LCP := NEXT
	      END;
	END;
      WRITE(OUTPUT,'<',SCREENDOTS:4,'>');
      STARTDOTS := SCREENDOTS;
      LCMAX := LC;
      LLP := DISPLAY[TOP].FLABEL;
      WHILE LLP <> NIL DO
	BEGIN GENLABEL(LLP^.CODELBP);
	  LLP := LLP^.NEXTLAB
	END;
      LCP := DISPLAY[TOP].FFILE;
      WHILE LCP <> NIL DO
	WITH LCP^,IDTYPE^ DO
	  BEGIN
	    GEN2(50(*LDA*),0,VADDR);
	    GEN2(50(*LDA*),0,VADDR+FILESIZE);
	    IF FILTYPE = NIL THEN GENLDC(-1)
	    ELSE
	      IF FILTYPE = CHARPTR THEN GENLDC(0)
	      ELSE GENLDC(FILTYPE^.SIZE);
	    GEN2(77(*CXP*),0(*SYS*),3(*FINIT*));
	    LCP := NEXT
	  END;
      REPEAT
	REPEAT STATEMENT(FSYS + [SEMICOLON,ENDSY])
	UNTIL NOT (SY IN STATBEGSYS);
	TEST := SY <> SEMICOLON;
	IF NOT TEST THEN INSYMBOL
      UNTIL TEST;
      IF SY = ENDSY THEN INSYMBOL ELSE ERROR(13);
      EXITIC := IC;
      LCP := DISPLAY[TOP].FFILE;
      WHILE LCP <> NIL DO
	WITH LCP^ DO
	  BEGIN
	    GEN2(50(*LDA*),0,VADDR);
	    GENLDC(0); GEN2(77(*CXP*),0(*SYS*),6(*FCLOSE*));
	    LCP := NEXT
	  END;
      IF FPROCP = NIL THEN GEN0(86(*XIT*))
      ELSE
	BEGIN
	  IF FPROCP^.PFLEV = 0 THEN LOP := 65(*RBP*)
	  ELSE LOP := 45(*RNP*);
	  IF FPROCP^.IDTYPE = NIL THEN GEN1(LOP,0)
	  ELSE GEN1(LOP,FPROCP^.IDTYPE^.SIZE)
	END;
      LLP := DISPLAY[TOP].FLABEL;  (* CHECK UNDEFINED LABELS *)
      WHILE LLP <> NIL DO
	WITH LLP^,CODELBP^ DO
	  BEGIN
	    IF NOT DEFINED THEN
	      IF REFLIST <> MAXADDR THEN ERROR(168);
	    LLP := NEXTLAB
	  END;
      JTINX := NEXTJTAB - 1;
      IF ODD(IC) THEN IC := IC + 1;
      WHILE JTINX > 0 DO
	BEGIN GENWORD(IC-JTAB[JTINX]); JTINX := JTINX-1 END;
      IF FPROCP = NIL THEN
	BEGIN GENWORD((LCMAX-LCAFTERMARKSTACK)*2); GENWORD(0) END
      ELSE
	WITH FPROCP^ DO
	  BEGIN GENWORD((LCMAX-LOCALLC)*2);
	    GENWORD((LOCALLC-LCAFTERMARKSTACK)*2)
	  END;
      GENWORD(IC-EXITIC); GENWORD(IC);
      GENBYTE(CURPROC); GENBYTE(LEVEL-1);
      IF NOT CODEINSEG THEN
	BEGIN CODEINSEG := TRUE;
	  SEGTABLE[SEG].DISKADDR := CURBLK
	END;
      WRITECODE(FALSE);
      SEGINX := SEGINX + IC;
      PROCTABLE[CURPROC] := SEGINX - 2
    END (*BODY*) ;

  PROCEDURE FINDFORW(FCP: CTP);
  BEGIN
    IF FCP <> NIL THEN
      WITH FCP^ DO
	BEGIN
	  IF KLASS IN [PROC,FUNC] THEN
	    IF PFDECKIND = DECLARED THEN
	      IF PFKIND = ACTUAL THEN
		IF FORWDECL THEN
		  BEGIN
		    USERINFO.ERRNUM := 117; WRITELN(OUTPUT);
		    WRITE(OUTPUT,NAME,' undefined')
		  END;
	  FINDFORW(RLINK); FINDFORW(LLINK)
	END
  END (*FINDFORW*) ;

  BEGIN (*BLOCK*)
    REPEAT
      IF SY = LABELSY THEN
	BEGIN INSYMBOL; LABELDECLARATION END;
      IF SY = CONSTSY THEN
	BEGIN INSYMBOL; CONSTDECLARATION END;
      IF SY = TYPESY THEN
	BEGIN INSYMBOL; TYPEDECLARATION END;
      IF SY = VARSY THEN
	BEGIN INSYMBOL; VARDECLARATION END;
      WHILE SY IN [PROCSY,FUNCSY,PROGSY] DO
	BEGIN LSY := SY; INSYMBOL;
	  IF LSY = PROGSY THEN SEGDECLARATION
	  ELSE PROCDECLARATION(LSY)
	END;
      IF SY <> BEGINSY THEN
	IF NOT (INCLUDING AND
	    (SY IN [LABELSY,CONSTSY,TYPESY,VARSY,PROCSY,FUNCSY,PROGSY])) THEN
	  BEGIN ERROR(18); SKIP(FSYS) END
    UNTIL SY IN STATBEGSYS;
    DP := FALSE; IC := 0; LINEINFO := 0;
    IF SY = BEGINSY THEN INSYMBOL ELSE ERROR(17);
    IF NOT SYSCOMP THEN FINDFORW(DISPLAY[TOP].FNAME);
    REPEAT BODY(FSYS + [CASESY]);
      IF SY <> FSY THEN
	BEGIN ERROR(6); SKIP(FSYS + [FSY]) END
    UNTIL (SY = FSY) OR (SY IN BLOCKBEGSYS);
  END (*BLOCK*) ;

BEGIN (*COMPILER*)
  COMPINIT; TIME(LGTH,LOWTIME);
  BLOCK(BLOCKBEGSYS+STATBEGSYS-[CASESY],PERIOD,OUTERBLOCK);
  IF SY <> PERIOD THEN ERROR(21);
  IF LIST THEN
    BEGIN SCREENDOTS := SCREENDOTS+1;
      SYMBUFP^[SYMCURSOR] := CHR(EOL);
      SYMCURSOR := SYMCURSOR+1; PRINTLINE
    END;
  FINISHSEG;
  TIME(LGTH,STARTDOTS); LOWTIME := STARTDOTS-LOWTIME;
  UNITWRITE(3,IC,7); WRITELN(OUTPUT);
  WRITE(OUTPUT,SCREENDOTS,' lines');
  IF LOWTIME > 0 THEN
    WRITE(OUTPUT,', ',(LOWTIME+30) DIV 60,' secs, ',
	ROUND((3600/LOWTIME)*SCREENDOTS),' lines/min');
  IC := 0;
  FOR SEG := 0 TO MAXSEG DO
    WITH SEGTABLE[SEG] DO
      BEGIN GENWORD(DISKADDR); GENWORD(CODELENG) END;
  FOR SEG := 0 TO MAXSEG DO
    WITH SEGTABLE[SEG] DO
      FOR LGTH := 1 TO 8 DO
	GENBYTE(ORD(SEGNAME[LGTH]));
  CURBLK := 0; CURBYTE := 0; WRITECODE(TRUE)
END (*COMPILE*) ;

BEGIN END.
